perm filename SWTCH2.SAI[BIG,HPM] blob sn#390199 filedate 1978-10-25 generic text, type T, neo UTF8
BEGIN "SWITCH"

INTEGER PORTS,ROWS,LEVELS,SIZE;
INTEGER I,J,K,L,M,C,T,F,II,JJ,KK;

PROCEDURE OTOI(INTEGER I,J,K; REFERENCE INTEGER II,JJ,KK);
    BEGIN
    INTEGER SUB,IMSUB;
    SUB←ROWS%PORTS↑K;
    IMSUB←I MOD SUB;
    KK←K+1;
    IF KK<LEVELS THEN
        BEGIN
        II←(J*SUB+IMSUB)%PORTS+I-IMSUB;
        JJ←IMSUB MOD PORTS;
        END
    ELSE
        BEGIN
        II←I;
        JJ←J;
        END;
    END;

INTEGER PROCEDURE FACT(INTEGER N);
    BEGIN T←1; WHILE N>0 DO BEGIN T←T*N; N←N-1; END; RETURN(T); END;

OUTSTR("PORTS:"); PORTS←CVD(INCHWL);
OUTSTR("LEVELS:"); LEVELS←CVD(INCHWL);
OUTSTR("ROWS:"); ROWS←CVD(INCHWL);
SIZE←ROWS*PORTS;

    BEGIN
    INTEGER ARRAY NET[0:ROWS-1,0:LEVELS,0:PORTS-1];
    INTEGER ARRAY STATE[0:ROWS-1,0:LEVELS];
    INTEGER ARRAY PERMS[0:PORTS-1,0:FACT(PORTS)-1],AVAIL,CNTR[-1:PORTS-1];
    F←FACT(PORTS);
    FOR I←-1 STEP 1 UNTIL PORTS-1 DO CNTR[I]←0;
    FOR J←0 STEP 1 UNTIL F-1 DO
        BEGIN
        FOR K←0 STEP 1 UNTIL PORTS-1 DO AVAIL[K]←1;
        FOR K←0 STEP 1 UNTIL PORTS-1 DO
            BEGIN
            M←0; WHILE AVAIL[M]=0 DO M←M+1;
            FOR L←1 STEP 1 UNTIL CNTR[K] DO
                   BEGIN M←M+1; WHILE AVAIL[M]=0 DO M←M+1; END;
            PERMS[K,J]←M; AVAIL[M]←0;
            END;
        M←PORTS-2;
        WHILE CNTR[M]≥PORTS-1-M DO BEGIN CNTR[M]←0; M←M-1; END;
        CNTR[M]←CNTR[M]+1;
        END;
    FOR I←0 STEP 1 UNTIL ROWS-1 DO
        BEGIN
        FOR J←0 STEP 1 UNTIL LEVELS-1 DO STATE[I,J]←0;
        FOR J←0 STEP 1 UNTIL PORTS-1 DO NET[I,0,J]←I*PORTS+J;
        END;

    FOR M←F↑(LEVELS*ROWS) STEP -1 UNTIL 1 DO
        BEGIN
        COMMENT  PROPOGATE THE MESSAGES THROUGH ;
        FOR K←0 STEP 1 UNTIL LEVELS-1 DO
        FOR I←0 STEP 1 UNTIL ROWS-1 DO
        FOR J←0 STEP 1 UNTIL PORTS-1 DO
            BEGIN
            OTOI(I,J,K,II,JJ,KK);
            NET[II,KK,JJ]←NET[I,K,PERMS[J,STATE[I,K]]];
            END;

        COMMENT  DO THE TEST HERE, ON LAST LEVEL;
            BEGIN
            INTEGER ARRAY PERM,PICD[0:SIZE-1];
            FOR I←0 STEP 1 UNTIL ROWS-1 DO
            FOR J←0 STEP 1 UNTIL PORTS-1 DO
                PERM[I*PORTS+J]←NET[I,LEVELS,J];
            I←SIZE; J←0;
            WHILE I>0 ∧ PICD[J]=0 DO
                BEGIN I←I-1; PICD[J]←1; J←PERM[J]; END;
            IF I=0 THEN
                BEGIN
                J←0;
                FOR I←0 STEP 1 UNTIL SIZE-1 DO
                    BEGIN PICD[I]←J; J←PERM[J]; END;
                OUTSTR(CVS(M)&"     ( ");
                FOR I←0 STEP 1 UNTIL ROWS-1 DO
                FOR J←0 STEP 1 UNTIL PORTS-1 DO OUTSTR(CVS(NET[I,LEVELS,J])&" ");
                OUTSTR(") - ( ");
                FOR I←0 STEP 1 UNTIL SIZE-1 DO OUTSTR(CVS(PICD[I])&" ");
                OUTSTR(")"&'15&'12);
                END;
            END;

        I←0; J←0;
        WHILE STATE[I,J]≥F-1 DO
            BEGIN
            STATE[I,J]←0;
            IF I<ROWS-1 THEN I←I+1 ELSE
                BEGIN
                I←0; J←J+1;
                END
             END;
        STATE[I,J]←STATE[I,J]+1;

        END;
    END;

END;